home *** CD-ROM | disk | FTP | other *** search
/ Internet Surfer: Getting Started / Internet Surfer - Getting Started (Wayzata Technology)(7231)(1995).bin / pc / mac / bonus / peter_le / finger_1 / tokens / lookup.p < prev    next >
Text File  |  1992-02-08  |  2KB  |  99 lines
  1. unit LOOKUP;
  2.  
  3. interface
  4.  
  5.     uses
  6.         ParameterDef;
  7.  
  8.     procedure Main (var p: parameterRecord);
  9.  
  10. implementation
  11.  
  12.     const
  13.         cr = chr(13);
  14.         spc = ' ';
  15.  
  16.     procedure Main (var p: parameterRecord);
  17.         var
  18.             rn: integer;
  19.             count, len: longInt;
  20.             s, t: str255;
  21.         function MyFSFill: OSErr;
  22.             var
  23.                 l: longInt;
  24.                 oe: OSErr;
  25.         begin
  26.             l := 254 - len;
  27.             if l > count then
  28.                 l := count;
  29.             count := count - l;
  30.             if l > 0 then
  31.                 oe := FSRead(rn, l, @s[len + 1]);
  32.             len := len + l;
  33.             if oe = eofErr then
  34.                 oe := noErr;
  35.             MyFSFill := oe;
  36.         end;
  37.         var
  38.             oe, ooe: OSErr;
  39.             ps: integer;
  40.             search1, search2, search3: str15;
  41.             l: longInt;
  42.     begin
  43.         p.expandtokens := true;
  44.         s := p.fingeredname^;
  45.         UprString(s, false);
  46.         ps := Pos(spc, s);
  47.         search2 := '';
  48.         search3 := '';
  49.         if ps = 0 then
  50.             search1 := s
  51.         else begin
  52.             search1 := copy(s, 1, ps - 1);
  53.             s := copy(s, ps + 1, 255);
  54.             ps := Pos(spc, s);
  55.             if ps = 0 then
  56.                 search2 := s
  57.             else begin
  58.                 search2 := copy(s, 1, ps - 1);
  59.                 search3 := copy(s, ps + 1, 15);
  60.             end;
  61.         end;
  62.         s := p.param^;
  63.         if s = '' then
  64.             s := ':Preferences:Lookup';
  65.         oe := FSOpen(s, 0, rn);
  66.         if oe = noErr then begin
  67.             oe := GetEOF(rn, count);
  68.             len := 0;
  69.             oe := MyFSFill;
  70.             while (oe = noErr) and (len > 0) do begin
  71.                 s[0] := chr(len);
  72.                 ps := Pos(cr, s);
  73.                 if ps = 0 then begin
  74.                     len := len + 1;
  75.                     s[len] := cr;
  76.                     ps := len;
  77.                 end;
  78.                 s[0] := chr(ps);
  79.                 t := s;
  80.                 UprString(s, false);
  81.                 if (Pos(search1, s) <> 0) and (Pos(search2, s) <> 0) and (Pos(search3, s) <> 0) then begin
  82.                     l := ps;
  83.                     if l > p.hlength - p.offset then
  84.                         l := p.hlength - p.offset;
  85.                     if l > 0 then begin
  86.                         BlockMove(@t[1], ptr(longInt(p.fingeroutput^) + p.offset), l);
  87.                         p.offset := p.offset + l;
  88.                     end;
  89.                 end;
  90.                 len := len - ps;
  91.                 if len > 0 then
  92.                     BlockMove(@s[ps + 1], @s[1], len);
  93.                 oe := MyFSFill;
  94.             end;
  95.             ooe := FSClose(rn);
  96.         end;
  97.     end;
  98.  
  99. end.